;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; This file is part of ICCLE2.
;
; ICCLE2 is free software: you can redistribute it and/or modify
; it under the terms of the GNU General Public License as published by
; the Free Software Foundation, either version 3 of the License, or
; (at your option) any later version.
;
; ICCLE2 is distributed in the hope that it will be useful,
; but WITHOUT ANY WARRANTY; without even the implied warranty of
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
; GNU General Public License for more details.
;
; You should have received a copy of the GNU General Public License
; along with ICCLE2.  If not, see <http://www.gnu.org/licenses/>.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;<h1><join>A Trick for Sketching Distributions</join></h1>
;<p>The ``bald1`` says that software should pass the <em>elbow
;test</em> i.e.
; <ul><em>users elbow the analyst out of the way in their haste to get to the
; screen to change something that is obviously wrong to them.</em></ul>
;<p> The only way for software to pass this test is if
; users can  rapidly comprehend what the software is saying.
; And the only way to do that is:
;<ol>
;<li>Seperate the high-level knowledge of the code away from the
;low-level details
;<li>Express that high-level knowledge in a human-readable form.
;</ul>
;<p>For example, of software that is <em>not</em> rapidly comprehensible,
;consider the following glorious example from the
;<a href="http://www2.us.ioccc.org/years.html">The
;International Obfuscated C Code Contest</a>:
;<pre>
;                                  #include\
;                                  <stdio.h>
;
;                      #include                <stdlib.h>
;                      #include                <string.h>
;
;                     #define w "Hk~HdA=Jk|Jk~LSyL[{M[wMcxNksNss:"
;                    #define r"Ht@H|@=HdJHtJHdYHtY:HtFHtF=JDBIl"\
;                   "DJTEJDFIlMIlM:HdMHdM=I|KIlMJTOJDOIlWITY:8Y"
;                  #define S"IT@I\\@=HdHHtGH|KILJJDIJDH:H|KID"\
;                 "K=HdQHtPH|TIDRJDRJDQ:JC?JK?=JDRJLRI|UItU:8T"
;                #define _(i,j)L[i=2*T[j,O[i=O[j-R[j,T[i=2*\
;               R[j-5*T[j+4*O[j-L[j,R[i=3*T[j-R[j-3*O[j+L[j,
;              #define t"IS?I\\@=HdGHtGIDJILIJDIItHJTFJDF:8J"
;
;     #define y                  yy(4),yy(5),                yy(6),yy(7)
;   #define yy(              i)R[i]=T[i],T[i ]            =O[i],O[i]=L [i]
; #define Y _(0          ], 4] )_ (1 ], 5] )_ (2      ], 6] )_ (3 ], 7] )_=1
; #define v(i)(      (( R[ i ] * _ + T [ i ]) * _ + O [ i ]) * _ + L [ i ]) *2
; double b = 32  ,l ,k ,o ,B ,_ ; int Q , s , V , R [8 ], T[ 8] ,O [8 ], L[ 8] ;
; #define q( Q,R ) R= *X ++ % 64 *8 ,R |= *X /8 &7 ,Q=*X++%8,Q=Q*64+*X++%64-256,
; # define  p      "G\\QG\\P=GLPGTPGdMGdNGtOGlOG"   "dSGdRGDPGLPG\\LG\\LHtGHtH:"
; #  define W         "Hs?H{?=HdGH|FI\\II\\GJlHJ"    "lFL\\DLTCMlAM\\@Ns}Nk|:8G"
; # define   U           "EDGEDH=EtCElDH{~H|AJk}"       "Jk?LSzL[|M[wMcxNksNst:"
; #  define u                  "Hs?H|@=HdFHtEI"             "\\HI\\FJLHJTD:8H"
; char  *   x                   ,*X , ( * i )[               640],z[3]="4_",
; *Z = "4,8O4.8O4G" r U "4M"u S"4R"u t"4S8CHdDH|E=HtAIDAIt@IlAJTCJDCIlKI\\K:8K"U
;  "4TDdWDdW=D\\UD\\VF\\FFdHGtCGtEIDBIDDIlBIdDJT@JLC:8D"t"4UGDNG\\L=GDJGLKHL\
; FHLGHtEHtE:"p"4ZFDTFLT=G|EGlHITBH|DIlDIdE:HtMH|M=JDBJLDKLAKDALDFKtFKdMK\
; \\LJTOJ\\NJTMJTM:8M4aGtFGlG=G|HG|H:G\\IG\\J=G|IG|I:GdKGlL=G|JG|J:4b"W
; S"4d"W t t"4g"r w"4iGlIGlK=G|JG|J:4kHl@Ht@=HdDHtCHdPH|P:HdDHdD=It\
; BIlDJTEJDFIdNI\\N:8N"w"4lID@IL@=HlIH|FHlPH|NHt^H|^:H|MH|N=J\\D\
; J\\GK\\OKTOKDXJtXItZI|YIlWI|V:8^4mHLGH\\G=HLVH\\V:4n" u t t
; "4p"W"IT@I\\@=HdHHtGIDKILIJLGJLG:JK?JK?=JDGJLGI|MJDL:8M4\
; rHt@H|@=HtDH|BJdLJTH:ITEI\\E=ILPILNNtCNlB:8N4t"W t"4u"
; p"4zI[?Il@=HlHH|HIDLILIJDII|HKDAJ|A:JtCJtC=JdLJtJL\
; THLdFNk|Nc|\
; :8K"; main (
; int C,char**        A) {for(x=A[1],i=calloc(strlen(x)+2,163840);
; C-1;C<3?Q=_=       0,(z[1]=*x++)?((*x++==104?z[1]^=32:--x), X =
; strstr(Z,z))      &&(X+=C++):(printf("P2 %d 320 4 ",V=b/2+32),
; V*=2,s=Q=0,C     =4):C<4?Q-->0?i[(int)((l+=o)+b)][(int)(k+=B)
; ]=1:_?_-=.5/    256,o=(v(2)-(l=v(0)))/(Q=16),B=(v(3)-(k=v(1)
; ))/Q:*X>60?y   ,q(L[4],L[5])q(L[6],L[7])*X-61||(++X,y,y,y),
; Y:*X>57?++X,  y,Y:*X >54?++X,b+=*X++%64*4:--C:printf("%d "
; ,i[Q][s]+i[Q ][s+1]+i[Q+1][s]+i[Q+1][s+1])&&(Q+=2)<V||(Q=
; 0,s+=2)<640
; ||(C=1));}
;</pre>This code takes a single command line argument, transcribes it
;    argument text into Tolkien's Elvish letters, then writes the
;    transcription to standard output as a portable graymap (PGM) file
;   (you saw that, right?).
;<p>Now compare that to the following code, written as a LISP macro,
;   then
;lets a user sketch a belief distribution (in this case, a normal
;   curve):<pre>
;(defun normal! ()
;  (buckets
;   ~
;   ~
;   ~~~
;   ~~~~~~
;   ~~~~~~~~~~
;   ~~~~~~~~~~
;   ~~~~~~
;   ~~~
;   ~
;   ~
;))</pre><p>(In the above, we use "<t>~</t>" to denote zero.)
;<p>Note that, if the users want another belief distribution, then can
;   sketch anything else they want using the following syntax.<pre>
(defconstant ~ 0)
(defconstant ~~ 1)
(defconstant ~~~ 2)
(defconstant ~~~~ 3)
(defconstant ~~~~~ 4)
(defconstant ~~~~~~ 5)
(defconstant ~~~~~~~ 6)
(defconstant ~~~~~~~~ 7)
(defconstant ~~~~~~~~~ 8)
(defconstant ~~~~~~~~~~ 9)
(defconstant ~~~~~~~~~~~ 10)
(defconstant ~~~~~~~~~~~~ 11)
(defconstant ~~~~~~~~~~~~~ 12)
(defconstant ~~~~~~~~~~~~~~ 13)
(defconstant ~~~~~~~~~~~~~~~ 14)
(defconstant ~~~~~~~~~~~~~~~~ 15)
(defconstant ~~~~~~~~~~~~~~~~~ 16)
(defconstant ~~~~~~~~~~~~~~~~~~ 18)
(defconstant ~~~~~~~~~~~~~~~~~~~ 19)
(defconstant ~~~~~~~~~~~~~~~~~~~~ 20)
;</pre>
;<p>Now this page just shows a very simple example of elbow-able
;languages.
; For more details, see the <a href="?hedges.lisp">hedges</a>
;file or
;Google on
;<a
;href="http://www.google.com/search?hl=en&client=firefox-a&rls=org.mozilla:en-US:official&hs=4AW&sa=X&oi=spell&resnum=0&ct=result&cd=1&q=language-oriented+programing&spell=1">Langauge-oriented
;programming</a>.
;But for a description of the machinery behind the <t>bucket</t>
;example, read on.
;<h2>Code</h2><p><t>Bucket</t> creates distributions:<pre>
(defstruct dist
  (buckets     (list2buckets  ; defaults to a flat distribition
                (make-sequence 'list (fixed-bins *f*)
                               :initial-element (/ 1.0 (fixed-bins *f*))))) 
  (cardinality (fixed-bins    *f*)) ; distributions are sets of size 'cardinality'
  (min         (fixed-bin-min *f*)) ; distributions range min to max
  (max         (fixed-bin-max *f*)))
;</pre>
;<p>A simple macro suffices:<pre>
(defmacro buckets (&rest l)
  `(list2dist ',(mapcar #'isa-num l)))

(defun isa-num (n)
  (if (numberp n) n (eval n)))

(defun list2dist (l)
  (normalize
   (make-dist :buckets  (list2buckets l))))

(defun list2buckets (l)
  (let ((want (fixed-bins *f*)))
    (if (eql want (length l))
        (let ((id 0))
          (mapcar #'(lambda (n) (cons (incf id) n)) l))
        (error "in defdist: ~a: not ~a items long" l want))))

(defun normalize (d)
  "Buckets should sum to one."
  (let ((sum 0.0))
    (dolist (bucket (dist-buckets d))
      (incf sum (rest bucket)))
    (setf (dist-buckets d)
          (mapcar #'(lambda (bucket)
                      (cons (first bucket)
                            (/ (rest bucket) sum)))
                  (dist-buckets d)))
    d))
;</pre>
;<h2>Standard Operations on distrubutions</h2>
;<p>(And-ing, or-ing, not-ing) = (max, min, compliment)<pre>
(defun cons-max (x y) (if (> (rest x) (rest y)) x y))
(defun cons-min (x y) (if (< (rest x) (rest y)) x y))
(defun cons-neg (x  ) (cons (first x) (- 1 (rest x))))

(defun dist-or   (d1 d2) (dist-combine d1 d2 #'cons-max))
(defun dist-and  (d1 d2) (dist-combine d1 d2 #'cons-min))

(defun dist-combine (d1 d2 fn)
    (normalize
     (make-dist 
      :min         (dist-min d1)
      :max         (dist-max d1)
      :cardinality (dist-cardinality d1)
      :buckets     (mapcar fn (dist-buckets d1) (dist-buckets d2)))))
  
(defun dist-not (d)
  (make-dist 
   :min         (dist-min d)
   :max         (dist-max d)
   :cardinality (dist-cardinality d)
   :buckets     (mapcar  #'cons-neg (dist-buckets d))))

(defun opposite (d)
  (let ((olds (dist-buckets d))
        (n -1)
        (cardinality (dist-cardinality d))
        news)
    (make-dist 
     :min         (dist-min d)
     :max         (dist-max d)
     :cardinality cardinality
     :buckets     (dolist (old olds news)
                    (push (cons (- cardinality (incf n)) (rest old)) news)))))
;</pre>
;<h2>Test cases</h2>
;<h3>Simple tests</h3><pre>
(deftest test-list2buckets ()
  (check
    '(equal '((1 . 1) (2 . 2) (3 . 3) (4 . 4) (5 . 5)
              (6 . 5) (7 . 4) (8 . 3) (9 . 2) (10 . 1))
      (defbuckets '(1 2 3 4 5 45 4 3 2 1)))))

(deftest test-freshdist ()
  (check
    (samep  "#S(DIST
                :BUCKETS ((1 . 0.1) (2 . 0.1) (3 . 0.1) (4 . 0.1) (5  . 0.1)
                          (6 . 0.1) (7 . 0.1) (8 . 0.1) (9 . 0.1) (10 . 0.1))
                :CARDINALITY 10
                :MIN 0
                :MAX 100)"
            (make-dist))))
  
(deftest test-normal! ()
  (check
    (samep "#S(DIST
               :BUCKETS ((1 . 0.0) (2 . 0.0) (3 . 0.0625) (4 . 0.15625) (5 . 0.28125)
                         (6 . 0.28125) (7 . 0.15625) (8 . 0.0625) (9 . 0.0) (10 . 0.0))
               :CARDINALITY 10
               :MIN 0
               :MAX 100)"
           (normal!))))

;</pre><h3>More Complex Tests</h3><pre>
(deftest test-opposite ()
  (check
    (samep (true-ish!)
           (opposite (opposite (true-ish!))))))

(deftest test-dist-and ()
  (check
    (samep (dist-and (true-ish!) (false-ish!))
           "#S(DIST
            :BUCKETS ((1 . 0.0) (2 . 0.0) (3 . 0.0) (4 . 0.16666666) (5 . 0.3333333)
                      (6 . 0.3333333) (7 . 0.16666666) (8 . 0.0) (9 . 0.0) (10 . 0.0))
            :CARDINALITY 10
            :MIN 0
            :MAX 100)")))

(deftest test-dist-or ()
  (check
    (samep (dist-or (true-ish!) (false-ish!))
           "#S(DIST
             :BUCKETS ((1 . 0.11764707) (2 . 0.11764707) (3 . 0.11764707)
                       (4 . 0.08823529) (5 . 0.058823533) (6 . 0.058823533)
                       (7 . 0.08823529) (8 . 0.11764707) (9 . 0.11764707)
                       (10 . 0.11764707))
             :CARDINALITY 10
             :MIN 0
             :MAX 100)")))

(deftest test-dist-not ()
   (check
     (samep (dist-and (true-ish!) (false-ish!))
            "#S(DIST
              :BUCKETS ((1 . 0.0) (2 . 0.0) (3 . 0.0) (4 . 0.16666666) (5 . 0.3333333)
                        (6 . 0.3333333) (7 . 0.16666666) (8 . 0.0) (9 . 0.0) (10 . 0.0))
              :CARDINALITY 10
              :MIN 0
              :MAX 100)")))
;</pre>
